home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1985-06-04 | 1.6 KB | 61 lines |
- 10 REM **** CPANODE ****
- 11 PRINT TAB(10);"**** THIS MODULE PRINTS THE NODE NUMBERS USED IN A PROJECT ****":PRINT
- 12 DEFINT B-Z:DEFSNG A
- 15 DIM S(1000),P(1000),N(500)
- 20 CLOSE
- 60 GOSUB 5000 'READ INPUT FILE
- 66 PRINT "**** SORTING NODES ****"
- 70 GOSUB 7000 'SORT START NODES
- 80 PRINT "**** THE FOLLOWING NODE NUMBERS ARE USED IN: "G$" ****"
- 117 PRINT S(P(1));:N(1)=S(P(1)):J=2
- 130 FOR I=2 TO N
- 140 IF S(P(I))<>S(P(I-1)) THEN PRINT S(P(I));:N(J)=S(P(I)):J=J+1
- 160 NEXT I
- 170 NN=J-1
- 175 PRINT "**** CREATING FILE OF NODE NUMBERS -";F$;".NDS ****"
- 177 H$=F$+".NDS"
- 180 OPEN H$ FOR OUTPUT AS #1
- 190 FOR I=1 TO NN
- 200 PRINT #1,N(I)
- 210 NEXT
- 212 PRINT "**** FILE: ";H$;" CREATED - USE OPTION 14 TO GLOBALLY CHANGE NODES ****"
- 214 PRINT:PRINT:INPUT "Press ENTER to continue ",Q$
- 216 CHAIN "CPAMENU"
- 5000 REM **** READING IN ALREADY CREATED INPUT FILE ******************
- 5010 INPUT "Enter the name of the input file [.CPM] ";G$
- 5015 IF G$="Q" OR G$="QUIT" THEN 3500
- 5020 P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
- 5030 IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
- 5035 ON ERROR GOTO 5300
- 5037 G$=F$+".CPM"
- 5038 OPEN G$ FOR INPUT AS #3
- 5040 INPUT #3,P$,T6$,DA$
- 5050 I=-1
- 5060 I=I+2
- 5070 IF EOF(3) THEN 5110
- 5080 INPUT #3,D$,S(I),S(I+1),O2,D,A6,PC,B,CT
- 5090 IF I+1/10=INT((I+1)/10) THEN PRINT I;
- 5100 GOTO 5060
- 5110 N=I-1
- 5120 CLOSE #3
- 5130 PRINT " **** INPUT FILE READ ****"
- 5140 RETURN
- 5300 PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
- 7000 REM **** SHELL METZNER SORT ****************************************
- 7020 J=N
- 7030 FOR I=1 TO N:P(I)=J:J=J-1:NEXT I
- 7040 M=N
- 7050 M=INT(M/2)
- 7060 IF M=0 THEN RETURN
- 7070 J=1
- 7080 K=N-M
- 7090 I=J
- 7100 L=I+M
- 7110 IF S(P(I))<S(P(L)) THEN 7160
- 7120 SWAP P(I),P(L)
- 7130 I=I-M
- 7140 IF I<1 THEN 7160
- 7150 GOTO 7100
- 7160 J=J+1
- 7170 IF J>K THEN 7050 ELSE 7090
-